Daniel Ackermann, Carsten Böhm, Frieder Haas
Import
library(ggplot2)
library(reshape2)
library(magrittr)
library(dplyr)
library(ggrepel)
library(cowplot)
library(gapminder)

Aufgabe 1

CSV einlesen
bliga <- read.csv("http://www.football-data.co.uk/mmz4281/1516/D1.csv") %>% #CSV einlesen
  select(Date:FTR) %>% #nur benätigte Spalten auswählen
  plyr::rename(c("HomeTeam" = "H", "AwayTeam" = "A")) %>% #Umbenennen der Spalten für späteren Vergleich
  mutate(matchday = rep(1:34, each=9))  %>% #Hinzufügen des Spieltags
  melt(measure.vars = c("H","A"), variable.name = "Place", value.name = "Team") #Tabelle in long Format umwandeln

Die Tabelle wird ins long Format umgewandelt, sodass in jeder Zeile nur ein Team vorhanden ist.

Berechnen der Punkte
levels(bliga$Place) <- c("H", "A", "D") #hinzufügen des "D" levels
bliga$Points <- 0 #alle Punkte auf 0 setzen
bliga$Points[bliga$FTR=="D"]<-1 #bei Unentschieden 1 Punkt
bliga$Points[bliga$FTR==bliga$Place]<-3 #Bei Übereinstimmung von FTR und Place, gab es einen Sieg. -> 3 Punkte
Kumulierte Summe bilden
bliga <- bliga %>%
  arrange(matchday) %>% #sortieren nach Spieltag
  group_by(Team) %>% #Teams gruppieren
  mutate(totalPts = cumsum(Points)) #errechnen der kumulierten Summe für jede Mannschaft an jedem Spieltag

Für jede Mannschaft wird pro Spieltag der Wert des vorigen Spieltags zu den an diesem Spieltag erzielten Punkten addiert.

Abkürzungstabelle erstellen
teamAbbr <- data.frame(Team = c("Augsburg", "Bayern Munich", "Darmstadt", "Dortmund",
                                "Ein Frankfurt", "FC Koln","Hamburg", "Hannover", 
                                "Hertha", "Hoffenheim", "Ingolstadt", "Leverkusen",
                                "M'gladbach", "Mainz", "Schalke 04", "Stuttgart", 
                                "Werder Bremen", "Wolfsburg"), 
                       Abbr = c("FCA", "FCB", "SV98", "BVB", "SGE", "KOE", "HSV", 
                                "H96", "BSC", "TSG", "FCI", "LEV", "BMG", "M05", 
                                "S04", "VFB", "BRE", "VFL"),
                       teamColor = c("red", "red", "blue", "goldenrod1", "red", "red", 
                                     "blue", "forestgreen", "blue", "blue", "black", "red", 
                                     "forestgreen", "red","blue", "red", "forestgreen", "forestgreen"))
bliga <- merge(bliga, teamAbbr) #Kombiniere bliga Tabelle mit teamAbbr Tabelle

Tabelle mit Abkürzungen und Teamfarbe für jedes Team, die dann mit der vorigen Tabelle vereint wird.

Plotten der Tabelle
g <- ggplot(bliga, aes(x=matchday, y=totalPts, group=Team, fill=Abbr, col=Team)) + #Plot
  geom_line(aes(color=Team), size=.8, alpha=.7) + #Zeichne Linien
  scale_x_continuous(breaks=pretty(bliga$matchday, n=max(bliga$matchday)),
                     expand = c(0, 0)) + #Verändern der x-Achsen-Skalendarstellung
  scale_y_continuous(breaks=pretty(bliga$totalPts, n=max(bliga$totalPts)),
                     expand = c(0, 0)) + #Verändern der y-Achsen-Skalendarstellung
  coord_cartesian(xlim = c(min(bliga$matchday), max(bliga$matchday) + 1.6),
                  ylim = c(min(bliga$totalPts),
                           max(bliga$totalPts) + .8)) + #Platz am rechten Rand schaffen für Teamnamen
  geom_text_repel(data = filter(bliga, matchday == max(matchday)),
                  aes(label=Abbr), size = 3, nudge_x = .8) + #Teamnamen ans ende der Linie schreiben
  labs(x = "match day", y = "points") + #Beschriftung der Achsen
  scale_color_manual(values=as.vector(teamAbbr$teamColor)) #Linien in Teamfarben darstellen

ggdraw(switch_axis_position(g + theme_light() + theme(legend.position = "none") , axis = 'y')) +
  theme(legend.position = "none") #Y-Achsen-Werte auf rechte Seite der Tabell verschieben

Aufgabe 2

CSV einlesen
ecoDat = read.csv(file=file.path("data", "EconomistData.csv"))
Berechnen des R2-Wertes
rsquared = summary(lm(log(CPI)~HDI, data=ecoDat))$r.squared #R^2 berechnen
rsquared
## [1] 0.5359422
rsquared = round(rsquared*100, 0) #Runden des Wertes
rsquared
## [1] 54
rsqstr = as.expression(bquote("R"^"2" * "= " * .(rsquared) * "%")) #String mit R^2 Wert generieren
Plotten der Tabelle
ggplot(ecoDat, aes(x=CPI, y=HDI, color=variable)) +
  geom_line(aes(fill="regline"),stat="smooth", position = "identity", color = "red", se=FALSE, 
            method = "lm", formula = y ~ log(x), size = 1, alpha=.6, show.legend = TRUE) + #Regressionslinie
  geom_point(shape=21, stroke=1, size=2.5, fill="white", aes(color=Region), alpha=.9) + #Datenpunkte
  scale_x_continuous(breaks=c(1:10), limits=c(1,10)) + #Verändern der x-Achsen-Skalendarstellung
  scale_y_continuous(breaks=seq(0,1,0.1), limits = c(0.2, 1.0)) + #Verändern der y-Achsen-Skalendarstellung
  ggtitle("Corruption and human development") + #Titel
  labs(x = "Corruption Perceptions Index, 2011 (10=least corrupt)", y = "Human Development Index, 2011 (1=best)")+ #Beschriftung der Achsen
  geom_text_repel(data = filter(ecoDat, Country %in% c("Afghanistan", "Greece", "China", "India",
                                                       "Rwanda", "Spain", "France", "United States",
                                                       "Japan", "Norway", "Singapore")),
                  aes(label=Country),color="black", size = 3, force=2, box.padding = unit(0.65, 'lines')) + #Beschriftungen der Datenpunkte
  guides(col=guide_legend(nrow=1, override.aes = list(linetype = 0), order=2)) + #Anpassung der Legende
  scale_color_manual(values = c("EU W. Europe"="#134B62",
                                "Americas"="#24A7DA",
                                "Asia Pacific"="#85D7F6",
                                "East EU Cemt Asia" = "#248E83",
                                "MENA"="#F15545",
                                "SSA"="#873829"), #Farben definieren
                     breaks = c("EU W. Europe","Americas","Asia Pacific","East EU Cemt Asia"
                                ,"MENA","SSA"), #Reihenfolge definieren
                     labels = c("OECD", "Americas","Asia &\nOceania","Central &\nEastern Europe",
                                "Middle East &\nnorth Africa","Sub-Saharan\nAfrica") #Namen ändern
                     )+
  scale_fill_manual(labels = rsqstr, values = NA)+ #R^2 Wert in Legende
  theme_light() + #Theme anwenden
  theme(axis.title=element_text(size = 10, face="italic"), 
        plot.title=element_text(size = 12, face="bold", hjust = 0),
        axis.ticks = element_blank(),
        legend.position="top",
        legend.title=element_blank(),
        legend.direction="horizontal",
        legend.box="horizontal",
        legend.box.just = "left",
        legend.key = element_blank(),
        legend.text.align = 0,
        legend.key.width = unit(.5, "cm"),
        legend.key.height = unit(.1, "cm"),
        legend.background=element_blank()
  )

Aufgabe 3

Einlesen der Daten
#gap<-data.frame(gapminder,color = I(continent_colors[match(gapminder$continent,names(continent_colors))]))
gap<-gapminder
  1. Auf die Farben des Pakets haben wir aufgrund der schlechten Farbauswahl verzichtet. Wir haben uns für die Auswertung der Daten von 1997 entschieden:
gapa<-filter(gap,year==1997)#Nur 1997
ggplot(gapa,aes(x=gdpPercap,y=lifeExp,group=continent))+
  geom_point(aes(size=pop,color=continent,stroke=1),alpha=0.5)+
  scale_x_log10(breaks=c(400,4000,40000))+
  scale_y_continuous(breaks=c(25,50,75))+
  labs(y="lifespan",x="income")+
  ggtitle("Lifespan and income in 1997")

b)Die “Daumenkino”-Version des im BBC-Video gezeigten zeitlichen Verlaufes von 1952-2007:

ggplot(gap,aes(x=gdpPercap,y=lifeExp,group=continent))+
  geom_point(aes(size=pop,color=continent,stroke=1),alpha=0.5)+
  scale_x_log10(breaks=c(400,4000,40000))+
  scale_y_continuous(breaks=c(25,50,75))+
  labs(y="lifespan",x="income")+
  facet_wrap(~year)+
  ggtitle("Lifespanand income over time (1952-1997)")

Hier wird dargestellt, wie sich die einzelnen Länder innerhalb der Regionen betreffend Lebenserwartung und BIP/Kopf zunächst 1952 und dann 2007 positionieren.

ggplot(filter(gap,year==1957),aes(x=gdpPercap,y=lifeExp,group=continent))+
  geom_point(aes(size=pop,color=continent,stroke=1),alpha=0.5)+
  scale_x_log10(breaks=c(400,4000,40000))+
  scale_y_continuous(breaks=c(25,50,75))+
  labs(y="lifespan",x="income")+
  facet_wrap(~continent)+
  ggtitle("Lifespan and income in 1957")

ggplot(filter(gap,year==2007),aes(x=gdpPercap,y=lifeExp,group=continent))+
  geom_point(aes(size=pop,color=continent,stroke=1),alpha=0.5)+
  scale_x_log10(breaks=c(400,4000,40000))+
  scale_y_continuous(breaks=c(25,50,75))+
  labs(y="lifespan",x="income")+
  facet_wrap(~continent)+
  ggtitle("Lifespan and income in 2007")

c)Hier wird versucht zunächst das Einkommen und dann die Lebenserwartung über die Zeit für alle Länder in einem Diagramm darzustellen. An dieser Grafik kann man erkennen, dass Afrika sowohl im Einkommen, als auch in der Lebenserwartung zwar deutlich zugelegt hat, allerdings im Vergleich zu den restlichen Kontinenten zurückliegt:

ggplot(gap,aes(x=year,y=gdpPercap,group=country,color=continent))+
  scale_y_log10(breaks=c(400,4000,40000))+
  geom_path(aes(alpha=0.1,size=2))+
  labs(y="income")+
  ggtitle("Income of 142 countries over time (1952-2007)")

ggplot(gap,aes(x=year,y=lifeExp,group=country,color=continent,size=2))+
  geom_path(aes(alpha=0.3))+
  labs(y="lifespan")+
  ggtitle("Lifespan of 142 countries over time (1952-2007)")

Da diese Übersicht die Möglichkeiten von geom_path nicht voll nutzt, sowohl Lebenserwartung als auch Einkommen darzustellen, haben wir zudem einen Graphen für nur ein Land (bezüglich der Fragestellung fahren wir uns nicht sicher, was gefragt ist) erstellt. Deutschland weißt einen Zuwachs sowohl in der Lebenserwartung, als auch im Einkommen auf und entpsricht somit der Aussage von BBC.

ggplot(filter(gap,country =="Germany"),aes(y=lifeExp,x=gdpPercap,group=country))+
  geom_path()+
  labs(y="lifespan",x="income")+
  ggtitle("Germanys income and lifespan over time(1952-2007)")

d)Wie sich in folgender Grafik zeigt, ist Kuwait ein sehr interessantes Land in diesem Kontext. Wie wir sehen ist hier die Lebenserwartung mit sinkendem pro Kopf-Einkommen gestiegen. Einen Grund hierfür liefert der starke Bevölkerungszuwachs von 160.000 Menschen 1952 zu 2.505.559 Menschen 2007. Da die Haupteinnahmequelle Öl nicht durch bspw. mehr Arbeiter gesteigert werden kann, sinkt das pro-Kopf Einkommen mit steigender Bevölkerungszahl. Die anderen drei Länder weisen trotz unterschiedlicher Niveaus, den allgemeinen Trend des BBC-Videos auf. Kuwait könnte hier also als Ausnahme gesehen werden.

ggplot(filter(gap, country %in% c("Kuwait","Singapore","China","India")),aes(x=gdpPercap,y=lifeExp,group=country,color=country))+
  scale_x_log10(breaks=c(400,4000,40000))+
  geom_path(aes(size=year))+
  labs(y="lifespan",x="income")+
  ggtitle("China, India, Kuwait and Singapor over time (1952-2007)")

e)Durch die folgenden zwei Darstellungen werden Lebenserwartung und Einkommen isoliert über die Zeit betrachtet und als Boxplotsdargestellt. Durch diese Unterscheidung werden zwei Dinge deutlich, welche in der BBC-Darstellung nicht so deutlich erkennbar waren. Betrachtet man das erste Schaubild der Lebenserwartung, so wird deutlich, dass sich vor allem der dargestellte Median positiv entwickelt, während die unteren und oberen Extrema der Boxplots einen schwächeren positiven Trend aufweisen. Die Darstellung des Einkommens hingegen verrät, dass die Schere zwischen armen und reichen Ländern wesentlich größer geworden ist. Vor allem die nicht-logarithmierte Darstellung verrät dies. Vorteil dieser Darstellung ist demnach die isolierte Betrachtungsmöglichkeit und die Verdeutlichung des Medians über die Zeit. Zudem ist durch die Verwendung von Boxplots die Gewichtung der einzelnen Länder im weltweiten Kontext (zumindest was Lebenserwartung und Einkommen betrifft) nun klar ersichtlich. Nachteilig ist, dass 2 Graphen benötigt werden und die einzelnen Länder nicht dargestellt werden.

ggplot(gap, aes(year, lifeExp))+ 
  geom_boxplot(aes(group = year))+
  labs(y="lifespan")+
  ggtitle("Lifespan of 142 countries over time in absolute values")

ggplot(gap, aes(year, gdpPercap))+ 
  geom_boxplot(aes(group = year))+
  labs(y="income")+
  ggtitle("Income of 142 countries over time in absolute values")

Aufgabe 4

Einlesen der Daten
eco <- read.table("data/WPP2015_DB02_Populations_Annual.csv", header=TRUE, sep=",")
Erstes Schaubild
eco2 <- eco %>%
  filter(Location %in% c("Latin America and the Caribbean","Africa", 
                         "Oceania", "Northern America", "Europe", "Asia"))%>%
  filter(Variant=="Medium") %>%
  filter(Time %in% c(2015,2050)) %>%
  arrange(Location) %>%
  group_by(Location) %>%
  mutate(PopChange = round(((PopTotal-lag(PopTotal))/lag(PopTotal))*100,1))%>%
  filter(!is.na(PopChange))%>%
  select(Location,PopChange)


  eco2$Location <- factor(eco2$Location, levels = eco2$Location[
    order(
    eco2$PopChange, decreasing =FALSE)
    ])
ggplot(eco2, aes(x=Location, y=PopChange))+
  geom_bar(stat="identity", position="dodge", aes(fill=Location), width=.6) + coord_flip()+
  ggtitle("Regional % change, 2015-50 forecast") + #Titel
  geom_text(aes(label=PopChange), position=position_dodge(width=0.5), vjust=+0.25, hjust=-1)+
  theme_minimal()+
  geom_hline(yintercept = 0)+
  scale_x_discrete(labels=c("Europe", "Asia", "North America","Latin America\n & the Caribbean", "Oceania", "Africa"))+
  scale_fill_manual(values = c("#1DAFED","#E8CE8C", "#B186B4", "#71BCBF", "#7A2818", "#F4856A"))+
  scale_y_continuous(limits=c(-5, 150), expand = c(0,0))+
  theme(
    plot.title=element_text(size = 12, face="bold", hjust = -.1),
    axis.text.x=element_blank(),
    axis.ticks = element_blank(),
    axis.title = element_blank(),
    legend.position="none",
    panel.background=element_blank(),
    panel.border=element_blank(),
    panel.grid.major=element_blank(),
    panel.grid.minor=element_blank(),
    plot.background=element_blank()
  )

Zweites Schaubild
eco3 <- eco %>%
  filter(Location %in% c("Latin America and the Caribbean","Africa", 
                         "Oceania", "Northern America", "Europe", "Asia"))%>%
  filter(Variant=="Medium") %>%
  filter(Time %in% c(2015,2050, 2099)) %>%
  select(Location,Time, PopTotal)%>%
  arrange(desc(Time), desc(PopTotal))

sumeco3 <- eco3 %>% #Summieren der Population pro Jahr
  group_by(Time)%>%
  summarise(Pop=round(sum(PopTotal)/1000000,1))

eco3$Time <- factor(eco3$Time, levels=eco3$Time)
ggplot(eco3, aes(x=Time, y=PopTotal, fill= Location))+
  geom_bar(stat="identity", width = .6) + coord_flip() +
  scale_fill_manual(values = c("Europe"="#1DAFED","Asia"="#E8CE8C", "Northern America"="#B186B4",
                               "Latin America and the Caribbean"="#71BCBF", "Oceania"="#7A2818", 
                               "Africa"="#F4856A"),
                    breaks = c("Europe","Asia","Northern America",
                               "Latin America and the Caribbean", "Oceania","Africa"), #Reihenfolge definieren
                    labels = c("Europe", "Asia", "North America","Latin America\n & the Caribbean",
                               "Oceania", "Africa") #Namen ändern
                    )+
  scale_y_continuous(limits = c(0,12.5*1000000), expand = c(0,0))+
  scale_x_discrete(labels=c("2100 forecast","2050 forecast","2015"))+
  ggtitle("Total population, bn") + #Titel
  geom_text(aes(label=c(rep("",5), sumeco3$Pop[sumeco3$Time=="2099"], 
                        rep("",5), sumeco3$Pop[sumeco3$Time=="2050"],
                        rep("",5), sumeco3$Pop[sumeco3$Time=="2015"])),
            position="stack", hjust=-1)+
  theme_minimal()+
  theme(
    plot.title=element_text(size = 14, face="bold", hjust = 0),
    axis.text.y=element_text(face="bold", size=12),
    axis.text.x=element_blank(),
    legend.title =element_blank(),
    legend.text =element_text(size=12),
    axis.ticks = element_blank(),
    legend.position="bottom",
    axis.title = element_blank(),
    panel.background=element_blank(),
    panel.border=element_blank(),
    panel.grid.major=element_blank(),
    panel.grid.minor=element_blank(),
    plot.background=element_blank()
  )

Drittes Schaubild

Für jedes Jahr wurde ein eigenes Schaubild ausgegeben

#Schaubild für 1950
eco4<-eco %>%
  filter(Time %in% c(1950,2015,2050),Variant=="Medium", Location %in% c("China","India","United States of America","Russian Federation","Japan","Germany","Indonesia","Brazil","United Kingdom","Italy","France","Bangladesh","Pakistan","Nigeria","Mexico","Philippines","Congo","Ethiopia","Egypt"))%>%
  arrange(desc(PopTotal),Time)

eco4$Location <- factor(eco4$Location, levels = eco4$Location[order(eco4$PopTotal, decreasing = FALSE)])

ggplot(head(filter(eco4, Time==1950),12),aes(x=Location, y=PopTotal,group=Time))+
  geom_bar(stat = "identity")+
  coord_flip()+
  labs(x = "") + labs(y = "")

#Schaubild für 2015
eco4<-eco %>%
  filter(Time %in% c(2015,2050),Variant=="Medium", Location %in% c("China","India","United States of America","Russian Federation","Japan","Germany","Indonesia","Brazil","United Kingdom","Italy","France","Bangladesh","Pakistan","Nigeria","Mexico","Philippines","Congo","Ethiopia","Egypt"))%>%
  arrange(desc(PopTotal),Time)

eco4$Location <- factor(eco4$Location, levels = eco4$Location[order(eco4$PopTotal, decreasing = FALSE)])

ggplot(head(filter(eco4, Time==2015),12),aes(x=Location, y=PopTotal,group=Time))+
  geom_bar(stat = "identity")+
  coord_flip()+
  labs(x = "") + labs(y = "")

#Schaubild für 2050 forecast
eco4<-eco %>%
  filter(Time==2050 ,Variant=="Medium", Location %in% c("China","India","United States of America","Russian Federation","Japan","Germany","Indonesia","Brazil","United Kingdom","Italy","France","Bangladesh","Pakistan","Nigeria","Mexico","Philippines","Democratic Republic of the Congo","Ethiopia","Egypt"))%>%
  arrange(desc(PopTotal),Time)

eco4$Location <- factor(eco4$Location, levels = eco4$Location[order(eco4$PopTotal, decreasing = FALSE)])
ggplot(head(filter(eco4, Time==2050),12),aes(x=Location, y=PopTotal,group=Time))+
  geom_bar(stat = "identity")+
  coord_flip()+
  labs(x = "") + labs(y = "")

Schaubilder in Grafikprogramm zusammengefügt

A4-3

Die unterschiedlichen Farben grenzen die Kontinente voneinander ab. Die Länder werden somit ihren Kontinenten zugewiesen. Als Resultat können nicht nur die Länder, sondern auch die Kontinente betrachtet werden. Mittels der Pfeile zwischen den einzelnen Schaubildern können Veränderungen schnell erkannt werden.

Deutlich zu erkennen ist in diesen Schaubildern, dass Europa enorm an Population verliert und die Bevölkerung in Afrika stark zunimmt. Auch Asien wächst weiterhin und besitzt mit China und Indien (auch 2050) die bevölkerungsreichsten Länder. Laut Prognose wird Indien 2050 Platz 1 belegen. Außerdem ist hervorzuheben, dass die Bevökerung Nigerias rapide gewachsen ist und sogar im Jahr 2050 auf Platz 3 (hinter Indien & China) progostiziert wird. Weitere Länder des afrikanischen Kontients (Kongo, Äthiopien, Ägypten) werden 2050 unter den bevökerungsreichsten Ländern vertreten sein.